perm filename PICTUR.SAI[SYS,HE]11 blob
sn#057815 filedate 1973-08-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00029 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 BEGIN "PICTUR"
C00007 00003 α table of picture file data block names
C00010 00004 α MISC. PROCEDURE
C00014 00005 α BEGINNING OF TVSIX PACKAGE
C00016 00006 α TVSIX REDUCTION ROUTINE
C00017 00007 α Super fast averager. SUMS and CLPINC determine the number of
C00020 00008 α low pass filter - START OF HIPASS PACKAGE
C00025 00009 α hipass filter
C00028 00010 α Compute the transformation matrices for the camera model
C00031 00011 ⊃ UPDATE THE TRANSFORM FOR SELECTED CAMERA
C00034 00012 ⊃ UPDATE CONTINUES
C00036 00013 ⊃ STILL MORE UPDATING
C00038 00014 ⊃ Now to update the global model
C00043 00015 α initialize the camera transfrom routines
C00045 00016 α convert text in array to string
C00047 00017 α first we initialize the world
C00049 00018 α get a picture from the disk
C00052 00019 α get a picture from the TV
C00054 00020 α Quam sixbit or regular TV input
C00056 00021 α determine which filters he wants to use
C00058 00022 α set up to set sensitivity
C00061 00023 α set sensitivity
C00064 00024 α and, finally, take the picture
C00066 00025 α and add a transform if wanted
C00068 00026 α display the picture, if clear picture
C00069 00027 α print the picture(s) if desired
C00071 00028 α set up to output to disk if desired
C00074 00029 α and write it out
C00076 ENDMK
C⊗;
BEGIN "PICTUR"
REQUIRE "HELIB[1,3]" LIBRARY;
REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE "VIDSUB[1,PDQ]" LOAD_MODULE;
REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
REQUIRE "PROLOG.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE 2000 STRING_SPACE;
REQUIRE "⊂⊃||" DELIMITERS;
DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂((BUF+1) LAND '777777)⊃, REFF=⊂REFERENCE⊃,
QUEST(NOVICE,QUESTION,TEST)=
⊂BEGIN IF ¬EXP THEN OUTSTR("NOVICE"&CRLF);
DO OUTSTR("QUESTION"&CRLF)
UNTIL TEST; END⊃,
XPOINT(S,L,P)=⊂((35-(P)) LSH 30)+((S) LSH 24)+(L)⊃,
RED=⊂2⊃, BLUE=⊂3⊃, GREEN=⊂4⊃, CLEAR=⊂1⊃, XDATA=⊂3⊃, P=⊂'17⊃,
Q=⊂'10000⊃, HAT(X,Y)=⊂(((X)-1) DIV (Y) +1)⊃;
EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN;REFF BOOLEAN FAIL;INT ARRAY STOR);
EXT PRO PICRD(REFF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REFF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO RELCOR(INT IOWD);
EXT INT PRO GETCOR(INT SIZE);
EXT BOOLEAN PRO VIDEO(INT EXP, X,Y);
EXT PRO INP;
EXT INT PRO GIOWD(INT ARRAY BUF);
EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
EXT PRO ADJUST;
EXT PRO CWHEEL(INT CODE);
EXT PRO TVIN;
EXT PRO PICSPL(BOOLEAN FLAG; STRING TITLE);
EXT PRO PORTR(STRING TITLE);
FORTRAN REAL PROCEDURE SIN;
FORTRAN REAL PROCEDURE COS;
FORTRAN REAL PROCEDURE SQRT(REAL X);
EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
EXTERNAL PROCEDURE CALLEN;
EXTERNAL PROCEDURE SPWOFF;
EXT PRO SUMSUB(INT ARRAY TV;INT OPTR1,OPTR2,OPTR3);
EXT PROCEDURE INVRT(REAL ARRAY A,AI);
EXT PRO PICWI(INT CH, FL, EXTR,PPN; REFF BOOLEAN FAIL);
EXT PRO PICOUT(REFF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO PICCLS;
α table of picture file data block names;
PRELOAD_WITH "LEFT (ONLY) CLEAR IMAGE",
"LEFT (ONLY) RED IMAGE",
"LEFT (ONLY) BLUE IMAGE",
"LEFT (ONLY) GREEN IMAGE",
"TITLE",
"DESCRIPTION",
"LEFT (ONLY) CAMERA TRANSFORM",
"LEFT (ONLY) CLEAR CODE TABLE",
"RIGHT CLEAR IMAGE",
"RIGHT RED IMAGE",
"RIGHT BLUE IMAGE",
"RIGHT GREEN IMAGE",
"RIGHT CAMERA TRANSFORM",
"RIGHT CLEAR CODE TABLE",
"STEREO REGISTRATION TABLE",
"MISC. 16",
"MISC. 17",
"MISC. 18",
"MISC. 19",
"MISC. 20",
"MISC. 21",
"MISC. 22",
"MISC. 23",
"MISC. 24",
"MISC. 25";
SAFE STRING ARRAY PICDES[1:25];
SAFE INTEGER ARRAY PICALLOC[1:25]; α allocation table for data blocks;
PRELOAD_WITH "Clear","Red", "Blue", "Green";
SAFE STRING ARRAY FILNAM[1:4];
PRELOAD_WITH 3,0,1,2;
SAFE INT ARRAY COLNUM[1:4];
EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF, IWID,
STATUS,TSERVO,LENS, BITS, LINLEN, LINES, TVCAM, STATE, POT, SSERVO;
EXT REAL P1, P2, P3, P4, P5, P6, P7, P8, CREF, SREF;
SAFE INT ARRAY PNTRS[1:25], DPYBUF[1:600], CLIPS[1:4,1:3], PIC[0:9];
SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
MART,SWING,FOC,FOCLEN0,GROREF,FOCLENG[1:5],DP,P0[1:5,1:3],PP[1:5,1:2];
INT I,EXP,ANS,FSAV,LLSAV,RSAV,LSAV,TVLENG,PICNUM,CAMERR,SUMS,CLPINC,
MIN,MAX,SUMPT1,SUMPT2,SUMPT3,TVSIZE,PICSIZE,J;
REAL PANPOT, FOCPOT, TILPOT, ZPOTD, ZPOT0, REF;
LABEL LOOP, SKIP, SKIP1, RESTOUT;
BOOLEAN SENSSET, TVREAD, SIXBIT, PARTDMP;
STRING STR, TITLE, DESCRIPT, FILENAM;
α MISC. PROCEDURE;
SIMPLE REAL PROCEDURE LNS(REAL X; INTEGER RLENS);
RETURN(X*FOC[RLENS]/(X-FOC[RLENS]));
α INDIRECT ARRBLT;
SIMPLE PROCEDURE ARRTO(INTEGER TOO; REFERENCE INTEGER FROM; INTEGER LENG);
START_CODE JRST ARRBLT; END;
SIMPLE PROCEDURE ARRFROM(REFERENCE INTEGER TOO; INTEGER FROM, LENG);
START_CODE JRST ARRBLT; END;
SIMPLE PROCEDURE ARRTOR(INTEGER TOO; REFERENCE REAL FROM;INTEGER LENG);
START_CODE JRST ARRBLT; END;
α Conversion from Quam format picture header array to hand-eye
library style parameters;
SIMPLE PROCEDURE Q2HE(SAFE INTEGER ARRAY PIC);
BEGIN
IWID←PIC[SIZEX];
FLINE←PIC[POSY];
LSIDE←PIC[POSX];
RSIDE←LSIDE+IWID-1;
LLINE←FLINE+PIC[SIZEY]-1;
LINLEN←PIC[SIZEL];
BITS←PIC[BIT];
END "Q2HE";
α Conversion from hand-eye library parameters to Quam format picture
header array;
SIMPLE PROCEDURE HE2Q(SAFE INTEGER ARRAY PIC);
BEGIN
PIC[SCALEX]←PIC[SCALEY]←1;
PIC[POSX]←LSIDE;
PIC[POSY]←FLINE;
PIC[SIZEX]←RSIDE-LSIDE+1;
PIC[SIZEY]←LLINE-FLINE+1;
PIC[SIZEL]←HAT(PIC[SIZEX],36 DIV BITS);
PIC[BIT]←BITS;
END "HE2Q";
α BEGINNING OF TVSIX PACKAGE;
SIMPLE PROCEDURE MINMAX(SAFE INTEGER ARRAY PARS);
BEGIN INTEGER NI,NJ;
NI←LINLEN*3;
NJ←PARS[SIZEY];
START_CODE
LABEL LI,LJ;
DEFINE A=⊂1⊃,I=⊂2⊃,J=⊂3⊃,P1=⊂4⊃,P2=⊂5⊃,P3=⊂6⊃;
DEFINE FOO(X)=⊂
ILDB A,X;
CAMGE A,MIN;
MOVEM A,MIN;
CAMLE A,MAX;
MOVEM A,MAX;⊃;
MOVE P1,SUMPT1;
MOVE P2,SUMPT2;
MOVE P3,SUMPT3;
MOVE J,NJ;
LJ: MOVE I,NI;
LI: FOO(P1)
FOO(P2)
FOO(P3)
SOJG I,LI;
SOJG J,LJ;
END;
END "MINMAX";
α Determines the size array needed for picture PIC,
allocates an array,
and sets and returns the appropriate PTR parameter;
INTEGER SIMPROC PICMAK(PICTURE PIC);
BEGIN
IF PIC[SIZEX]=0 THEN RETURN(0);
PIC[SIZEL]←HAT(PIC[SIZEX],36 DIV PIC[BIT]);
PICSIZE ← GETCOR(PIC[SIZEL]*PIC[SIZEY]);
RETURN(PIC[PTR]←XPOINT(PIC[BIT],BHEAD(PICSIZE),-1));
END "PICMAK";
α TVSIX REDUCTION ROUTINE;
SIMPLE PROCEDURE REDUCER(SAFE INTEGER ARRAY PARS);
BEGIN
INTEGER NI,NJ,RPT,LL,SCALE;
SCALE←(64*Q-1)%(MAX-MIN);
NI←3*LINLEN;
NJ←PARS[SIZEY];
RPT←PARS[PTR];
LL←PARS[SIZEL];
START_CODE
LABEL L,LI;
DEFINE A=⊂1⊃,I=⊂2⊃,J=⊂3⊃,P1=⊂4⊃,P2=⊂5⊃,P3=⊂6⊃,R=⊂7⊃;
DEFINE FOO(X)=⊂
ILDB A,X;
SUB A,MIN;
IMUL A,SCALE;
ASH A,'777764;
IDPB A,R;⊃;
MOVE P1,SUMPT1;
MOVE P2,SUMPT2;
MOVE P3,SUMPT3;
MOVE R,RPT;
MOVE J,NJ;
LI: MOVE I,NI;
L: FOO(P1)
FOO(P2)
FOO(P3)
SOJG I,L;
MOVE R,LL;
ADDB R,RPT;
SOJG J,LI;
END;
END "REDUCER";
α Super fast averager. SUMS and CLPINC determine the number of
averages and clip level ranges;
PROCEDURE SUMMER(INTEGER ARRAY PARS,SUM;INTEGER SUMS,CLPINC);
BEGIN
LINLEN←(PARS[SIZEX]-1)%9+1;
TVSIZE←LINLEN*LINES;
BEGIN INTEGER ARRAY TVBUF[1:TVSIZE];
INTEGER SUMCNT;
SUMPT1←POINT(12,SUM[1,1,1],-1);
SUMPT2←SUMPT1+TVSIZE;
SUMPT3←SUMPT2+TVSIZE;
MIN←1 LSH 34;
MAX←0;
TVWORD←GIOWD(TVBUF);
FOR SUMCNT←1 STEP 1 UNTIL SUMS DO
BEGIN
TCLIP←0;
BCLIP←CLPINC-1;
WHILE BCLIP ≤ 7 DO
BEGIN
TVIN;
SUMSUB(TVBUF,SUMPT1,SUMPT2,SUMPT3);
TCLIP←TCLIP+CLPINC;
BCLIP←BCLIP+CLPINC;
END;
END;
END;
END "SUMMER";
PROCEDURE TVSIX(SAFE INTEGER ARRAY PARS;INTEGER SUMS,CLPINC);
BEGIN INTEGER ADR, TVSAV;
PARS[SIZEL]←(PARS[SIZEX]-1)%6+1;
TVSAV ← TVWORD;
ADR←(TVWORD+1) LAND '777777;
PARS[PTR]←XPOINT(6,ADR,-1);
PARS[BIT]←6;
Q2HE(PARS);
LINLEN←(PARS[SIZEX]-1)%9+1;
LINES←LLINE-FLINE+1;
BEGIN INTEGER ARRAY SUM[1:3,1:LINES,1:LINLEN];
SUMMER(PARS,SUM,SUMS,CLPINC);
MINMAX(PARS);
REDUCER(PARS);
END;
TVWORD ← TVSAV;
END "TVSIX";
α low pass filter - START OF HIPASS PACKAGE;
PROCEDURE LOPASS(PICTURE PIC,OUT;INTEGER AVGX,AVGY);
BEGIN INTEGER_ARRAY COLSUM,COLN[-AVGX+1:PIC[SIZEX]];
INTEGER I,J,HH,OI,OPT1,PT1,OPT2,PT2,OPTO,PTO,S,N,AVGX2,AVGY2,
SIZL,AVGTSH;
AVGX2←AVGX DIV 2;
AVGY2←AVGY DIV 2;
SIZL←PIC[SIZEL];
AVGTSH←AVGX*AVGY/4;
HH←PIC[SIZEX];
OI←-(PIC[SIZEX]+AVGX2);
OPT1←0;
OPT2←PIC[PTR];
OPTO←0;
FOR J←1 STEP 1 UNTIL PIC[SIZEY]+AVGY2 DO
BEGIN "LJ"
IF J=AVGY2+1 THEN OPTO←OUT[PTR]
ELSE IF J=AVGY+1 THEN OPT1←PIC[PTR]
ELSE IF J>PIC[SIZEY] THEN OPT2←0;
PT1←OPT1;
PT2←OPT2;
PTO←OPTO;
START_CODE
DEFINE A=⊂1⊃,B=⊂2⊃,I=⊂3⊃,G=⊂4⊃,N=⊂5⊃,S=⊂6⊃,H=⊂7⊃;
LABEL LI,LIA,LIB,LIC,LID,LI3,LI1,LI2,LIX;
MOVE COLSUM;
HRRM LIB;
ADD AVGX;
HRRM LIA;
MOVE COLN;
HRRM LID;
ADD AVGX;
HRRM LIC;
MOVE G,AVGX2;
MOVE H,HH;
SETZB N,S;
HRLZ I,OI;
LI: SOJL H,LI3;
ILDB B,PT1;
ILDB A,PT2;
JUMPE B,LI1;
JUMPE A,LI2;
SUB A,B;
LIA: ADDB A,(I);
LIC: ADD N,(I);
LIB: SUB A,(I);
LID: SUB N,(I);
ADDB S,A;
IDIV A,N;
CAMG N,AVGTSH;
MOVEI A,0;
SOSGE G;
IDPB A,PTO;
AOBJN I,LI;
JRST LIX;
LI3: SETZB A,B;
JRST LIB;
LI1: JUMPE A,LIA;
AOS @LIC;
JRST LIA;
LI2: MOVN A,B;
SOS @LIC;
JRST LIA;
LIX: END;
OPT1←OPT1+SIZL;
OPT2←OPT2+SIZL;
OPTO←OPTO+SIZL;
END "LJ";
END "LOPASS";
α hipass filter;
INTEGER PROCEDURE DIFFPIC(PICTURE INP,INP2,OUT;REAL K1,K2,OFF);
BEGIN α PICTURE DIFFERENCER, INP-INP2 COPIED TO OUT;
INTEGER IBITS,ADR,PTI,PTI2,PTO,NX,NY,NLI,OFF2,MAXV;
BOOLEAN INPLACE;
SHORT INTEGER I;
INTEGER_ARRAY CTAB[0:MAXV←1 LSH (IBITS←INP[BIT])-1];
PTI←INP[PTR];
PTI2←INP2[PTR];
OFF2←1 LSH (IBITS-1);
NLI←INP[SIZEL];
NX←INP[SIZEX];
NY←INP[SIZEY];
PTO←OUT[PTR];
CTAB[0]←-INFINITY;
FOR I←1 STEP 1 UNTIL MAXV DO CTAB[I]←(OFF-I*K2)/K1+OFF2;
START_CODE
LABEL LI,LJ,LJ2,LNEG,LI2,LX,LX2;
DEFINE A=⊂'14⊃,B=⊂'15⊃,I=⊂'13⊃,PI1=⊂'10⊃,PI2=⊂'7⊃,PO=⊂'11⊃;
MOVE PI1,PTI;
MOVE PI2,PTI2;
MOVE PO,PTO;
HRR 5,CTAB;
HRRM 5,LX;
HRR 5,MAXV;
HRRM 5,LX2;
LJ: MOVE I,NX;
LI: ILDB A,PI1;
ILDB B,PI2;
JUMPE A,LI2;
LX: ADD A,(B);
JUMPL A,LNEG;
LX2: CAIL A, ;
HRRZ A,LX2;
LI2: IDPB A,PO;
SOJG I,LI;
JRST LJ2;
LNEG: SKIPE A,B;
MOVEI A,1;
JRST LI2;
LJ2: MOVE PI1,NLI;
MOVE PI2,PI1;
ADDB PI1,PTI;
ADDB PI2,PTI2;
MOVE PO,NLI;
ADDB PO,PTO;
SOSLE NY;
JRST LJ;
END;
RETURN(ADR);
END "DIFFPIC";
α This procedure performs a simple minded high-pass spacial filter
on picture INP producing picture OUT.
OUT[i,j]←INP[i,j]-K1*LOWPASS(INP)[i,j]+k2, where LOWPASS[i,j]
is the local average intensity of INP computed on a window
AVGX by AVGY pixels in size centered at i,j;
PROCEDURE HIPASS;
BEGIN
SAFE INTEGER ARRAY PIC,LO[0:PICMAX];
HE2Q(PIC);
PIC[PTR]←XPOINT(PIC[BIT],BHEAD(TVWORD),-1);
PIC[GAIN]←-PIC[GAIN];
ARRTRAN(LO,PIC);
LO[NAME] ← 0;
PICMAK(LO);
LOPASS(PIC,LO,21,21);
DIFFPIC(PIC,LO,PIC,1,0.7,0);
RELCOR(PICSIZE);
PIC[PTR] ← LO[PTR] ← 0;
Q2HE(PIC);
END;
α Compute the transformation matrices for the camera model;
PROCEDURE PANTIL_CAM(INTEGER C;REAL PPOT,TPOT,FPOT,ZPOT;REAL ARRAY COL,ICOL,CENTER);
BEGIN INTEGER I,J;
REAL ACC,FMX,FMY,PAN,TILT;
REAL ARRAY RP,RT,RPT,RS,R[1:3,1:3],CC[1:3];
PAN ← PPOTD[C]*PPOT+PPOT0[C];
TILT ← TPOTD[C]*TPOT+TPOT0[C];
FMY ← FPOTD[C]*FPOT+FPOT0[C];
IF TVCAM=2 THEN FMY ← FMY+ZPOTD/(ZPOT-ZPOT0);
FMX ← FMY*MART[C];
RP[2,3]←-1;
RPT[1,1]←RP[1,1]←RP[3,2]←-SIN(PAN);
RP[3,1]←-(RPT[1,2]←RP[1,2]←COS(PAN));
RT[1,1]←1;
RPT[2,3]←-(RT[2,2]←RT[3,3]←COS(TILT));
R[3,3]←RPT[3,3]←RT[2,3]←-(RT[3,2]←SIN(TILT));
RPT[2,1]←RT[2,3]*RP[3,1];
RPT[2,2]←RT[2,3]*RP[3,2];
R[3,1]←RPT[3,1]←RT[3,3]*RP[3,1];
R[3,2]←RPT[3,2]←RT[3,3]*RP[3,2];
RS[3,3]←1;
RS[1,1]←RS[2,2]←COS(SWING[C]);
RS[2,1]←-(RS[1,2]←SIN(SWING[C]));
R[1,1]←RS[1,1]*RPT[1,1]+RS[1,2]*RPT[2,1];
R[1,2]←RS[1,1]*RPT[1,2]+RS[1,2]*RPT[2,2];
R[1,3]←RS[1,2]*RPT[2,3];
R[2,1]←RS[2,1]*RPT[1,1]+RS[2,2]*RPT[2,1];
R[2,2]←RS[2,1]*RPT[1,2]+RS[2,2]*RPT[2,2];
R[2,3]←RS[2,2]*RPT[2,3];
CC[1]←P0[C,1]+R[1,1]*DP[C,1]+R[2,1]*DP[C,2]+R[3,1]*DP[C,3];
CC[2]←P0[C,2]+R[1,2]*DP[C,1]+R[2,2]*DP[C,2]+R[3,2]*DP[C,3];
CC[3]←P0[C,3]+R[1,3]*DP[C,1]+R[2,3]*DP[C,2]+R[3,3]*DP[C,3];
FOR I←1 STEP 1 UNTIL 3 DO
BEGIN
COL[I,1]←R[I,1];
COL[I,2]←R[I,2];
ACC←0;
FOR J←1 STEP 1 UNTIL 3 DO ACC←ACC-R[I,J]*CC[J];
COL[I,3]←ACC;
END;
FOR J←1 STEP 1 UNTIL 3 DO
BEGIN
COL[2,J]←-FMX/333*COL[1,J]+FMY*COL[2,J]
+(PP[C,2]-PP[C,1]/333)*COL[3,J];
COL[1,J]←FMX*COL[1,J]+PP[C,1]*COL[3,J];
END;
INVRT(COL,ICOL);
ARRTRAN(CENTER,CC);
END "PANTIL";
⊃ UPDATE THE TRANSFORM FOR SELECTED CAMERA;
INTEGER PROCEDURE CAM_UPDATE;
BEGIN LABEL ETA;
DEFINE C1="2.1429", C2="-.0006", DEG="57.29578", KY="684.5";
REAL SFOC,STIL,SPAN,FMAX,FMIN,TMAX,TMIN,PMAX,PMIN,SZOM,ZMAX,IPOT,ZOOPOT,
ZMIN,DIFFOC,DIFTIL,DIFPAN,DIFZOM,SIND,IMAX,IMIN,DIFIRIS,SIRIS;
SAFE REAL ARRAY MCOL, MICOL[1:3,1:3], LCEN[1:3];
INTEGER I, IND, UPDFLG;
ETA: UPDFLG ← SFOC←SPAN←STIL←SZOM←SIRIS←0;
FMAX←TMAX←PMAX←ZMAX←IMAX←-10000;
FMIN←TMIN←PMIN←ZMIN←IMIN←10000;
IF TVCAM=1 THEN
BEGIN "CM1UPD"
IMAX ← IMIN ← 0;
STATUS←1;
SPWON(1,TSERVO);
I ← '44;
FOR IND←0 STEP 1 UNTIL 39 DO
BEGIN "CM1LOP"
STATUS←I;
I ← 4;
WHILE ¬(STATUS LAND 1) DO;
IF '100≤STATUS<'100000 THEN DONE;
SFOC←SFOC+P1;
STIL←STIL+P2;
SPAN←SPAN+P3;
IF P1>FMAX THEN FMAX←P1;
IF P1<FMIN THEN FMIN←P1;
IF P2>TMAX THEN TMAX←P2;
IF P2<TMIN THEN TMIN←P2;
IF P3>PMAX THEN PMAX←P3;
IF P3<PMIN THEN PMIN←P3;
END "CM1LOP";
SPWOFF;
END "CM1UPD";
IF TVCAM=2 THEN
BEGIN "CM2UPD"
FOR IND←0 STEP 1 UNTIL 39 DO
BEGIN "CM2LOP"
STATE ← 0;
POT ← 1;
SPWON(0,SSERVO);
WHILE ¬STATE DO;
SPWOFF;
IF ¬(STATE=1) THEN DONE;
SPAN←SPAN+P4;
SFOC←SFOC+P6;
STIL←STIL+P5;
SZOM←SZOM+P7;
SIRIS←SIRIS+P8;
⊃ UPDATE CONTINUES;
IF P4>PMAX THEN PMAX←P4;
IF P4<PMIN THEN PMIN←P4;
IF P5>TMAX THEN TMAX←P5;
IF P5<TMIN THEN TMIN←P5;
IF P6>FMAX THEN FMAX←P6;
IF P6<FMIN THEN FMIN←P6;
IF P7>ZMAX THEN ZMAX←P7;
IF P7<ZMIN THEN ZMIN←P7;
IF P8>IMAX THEN IMAX←P8;
IF P8<IMIN THEN IMIN←P8;
END "CM2LOP";
END "CM2UPD";
LENS ← IF TVCAM=2 THEN 5 ELSE LENS+1;
IF IND>0 THEN
BEGIN "READOK"
REF← GROREF[LENS];
FOCPOT←SFOC*REF/IND;
TILPOT←STIL*REF/IND;
PANPOT←SPAN*REF/IND;
IPOT ← SIRIS*REF/IND;
IF TVCAM=2 THEN ZOOPOT←SZOM*REF/IND;
IF IND<30 THEN
BEGIN "RDLOW"
OUTSTR("NOT ENOUGH UPDATE READINGS "&
CVS(IND)&" "&CRLF);
UPDFLG ← 8;
END "RDLOW" ELSE BEGIN "RDHIGH"
REAL DP, DT, DF, DZ, DI;
DIFFOC←(FMAX-FMIN)*REF;
DIFTIL←(TMAX-TMIN)*REF;
DIFPAN←(PMAX-PMIN)*REF;
DIFIRIS←(IMAX-IMIN)*REF;
IF TVCAM=2 THEN DIFZOM←(ZMAX-ZMIN)*REF;
SIND←4*SQRT(IND);
DZ ← IF TVCAM=2 THEN DIFZOM/SIND ELSE 0;
DF←DIFFOC/SIND;
DT←DIFTIL/SIND;
DP←DIFPAN/SIND;
DI←DIFIRIS/SIND;
⊃ STILL MORE UPDATING;
IF DI>.75∨DP>.75∨DT>.75∨DF>1∨(TVCAM=2∧DZ>1) THEN
BEGIN "DIFBAD"
OUTSTR("UPDATE POTS TOO NOISY ");
IF DF>1.0 THEN OUTSTR(" DIFFOC="&
CVF(DIFFOC));
IF DT>.75 THEN OUTSTR(" DIFTIL="&
CVF(DIFTIL));
IF DP>.75 THEN OUTSTR(" DIFPAN="&
CVF(DIFPAN));
IF DI>.75 THEN OUTSTR(" DIFIRIS="&
CVF(DIFIRIS));
IF DZ>1.0 THEN OUTSTR(" DIFZOM="&
CVF(DIFZOM));
OUTSTR(NULL&CRLF);
UPDFLG ← 9;
END "DIFBAD";
END "RDHIGH";
END "READOK" ELSE BEGIN "READBD"
OUTSTR("AD NOT AVAILABLE"&CRLF);
UPDFLG ← 10;
END "READBD";
IF ¬UPDFLG THEN
BEGIN "ERROR"
OUTSTR("...TYPE Y TO TRY AGAIN:"&CRLF);
IF INCHWL="Y" THEN GOTO ETA ELSE
IF UPDFLG=10 THEN
BEGIN "ADERR"
OUTSTR("CAM_UPDATE-FAILED"&CRLF);
RETURN(UPDFLG);
END "ADERR";
END "ERROR";
⊃ NOW WE HAVE A GOOD SET OF POT READINGS, UPDATE THE TRANSFORM;
PANTIL_CAM(LENS,PANPOT,TILPOT,FOCPOT,ZOOPOT,MCOL,MICOL,LCEN);
IF TVCAM=2 THEN
BEGIN
FOC[5] ← C1+ZOOPOT+C2;
FOCLEN0[5] ← FPOT0[5]+ZPOTD/((ZOOPOT-ZPOT0)*KY);
FOCLENG[5] ← FPOTD[5]/KY;
END;
⊃ Now to update the global model;
ARRBLT (CAMERA_MODEL[1,1],MCOL[1,1],9);
ARRBLT (CAMERA_MODEL[6,1],MICOL[1,1],9);
ARRBLT (CAMERA_MODEL[4,1],LCEN[1],3);
CAMERA_MODEL[5,1] ← PP[LENS,1];
CAMERA_MODEL[5,2] ← PP[LENS,2];
CAMERA_MODEL[5,3] ← 1.0;
CAMERA_MODEL[9,1] ← (PPOTD[LENS]*PANPOT+PPOT0[LENS])*DEG;
CAMERA_MODEL[9,2] ← (TPOTD[LENS]*TILPOT+TPOT0[LENS])*DEG;
CAMERA_MODEL[9,3] ← LNS(FOCLEN0[LENS]+FOCLENG[LENS]*FOCPOT,LENS);
CAMERA_MODEL[10,3] ← IPOT;
CAMERA_MODEL[10,2] ← IF TVCAM=1 THEN LENS ELSE FOC[5]*25.4;
CAMERA_MODEL[10,1]←TVCAM;
RETURN(UPDFLG);
END "CAM_UPDATE";
α initialize the camera transfrom routines;
DEFINE DATASET=⊂(IF CAMNOM=1 THEN "DATA1[CAL,HE]" ELSE
"DATA2[CAL,HE]")⊃,
DATA=⊂3⊃;
PROCEDURE COMIN(INTEGER I);
BEGIN DEFINE XF(X)="ARRYIN(DATA,X,1)",AF(X,N)="ARRYIN(DATA,X,N)";
IF I=5 THEN BEGIN XF(ZPOT0);XF(ZPOTD);END;
XF(PPOT0[I]);
XF(PPOTD[I]);
XF(TPOT0[I]);
XF(TPOTD[I]);
XF(FPOT0[I]);
XF(FPOTD[I]);
XF(MART[I]);
XF(SWING[I]);
AF(PP[I,1],2);
AF(P0[I,1],3);
AF(DP[I,1],3);
XF(FOC[I]);
XF(FOCLEN0[I]);
XF(FOCLENG[I]);
XF(GROREF[I]);
END;
DEFINE DATASET=⊂(IF CAMNOM=1 THEN "DATA1[CAL,HE]" ELSE
"DATA2[CAL,HE]")⊃,
DATA=⊂3⊃;
SIMPLE BOOLEAN PROCEDURE CAM_INIT;
BEGIN INTEGER BRK, EOF, S, CAMNOM;
OPEN(DATA,"DSK",12,3,0,128,BRK,EOF);
FOR CAMNOM←1,2 DO
BEGIN
I ← IF CAMNOM=1 THEN 4 ELSE 1;
FOR S ← 1 STEP 1 UNTIL I DO
BEGIN
LOOKUP(DATA,DATASET,BRK);
IF BRK THEN
BEGIN
OUTSTR(DATASET&" NOT FOUND"&CRLF);
RETURN(TRUE);
END;
USETI(DATA,1);
BRK←WORDIN(DATA);
USETI(DATA,S);
COMIN(IF CAMNOM=1 THEN S ELSE 5);
END;
CLOSE(DATA);
END;
RELEASE(DATA);
RETURN(FALSE);
END;
α convert text in array to string;
STRING PROCEDURE STRCOM(INTEGER BUF);
BEGIN STRING FOO;
INTEGER STRT, LENG;
FOO ← NULL;
LENG ← ABS(BUF DIV (2↑18))+1;
STRT ← BHEAD(BUF);
BEGIN INTEGER ARRAY X[1:LENG];
INTEGER I, J;
ARRFROM(X[1],STRT,LENG);
FOR I←1 STEP 1 UNTIL LENG DO
BEGIN STRING Y;
Y ← CVSTR(X[I]);
FOR J←1 STEP 1 UNTIL 5 DO IF ¬Y[J FOR 1] THEN
RETURN(FOO&(Y[1 TO J-1]));
FOO ← FOO&Y;
END;
END;
RETURN(FOO);
END;
α convert string to text in array;
INTEGER PROCEDURE ARRYCOM(STRING S);
BEGIN INTEGER STRT, LENG, BUF;
LENG ← LENGTH(S);
LENG ← IF ¬(LENG MOD 5) THEN LENG DIV 5 ELSE (LENG DIV 5)+1;
BEGIN INTEGER ARRAY X[1:LENG];
INTEGER I;
FOR I←1 STEP 1 UNTIL LENG DO
BEGIN
X[I] ← CVASC(S[1 FOR 5]);
S ← S[6 TO ∞];
END;
BUF ← GETCOR(LENG);
STRT ← BHEAD(BUF);
ARRTO(STRT,X[1],LENG);
END;
RETURN(BUF);
END;
α first we initialize the world;
TCLIP ← 0;
BCLIP ← 7;
SENSSET ← EXP ← FALSE;
CAMERR ← CAM_INIT;
QUEST (|Responses to questions are the upper case letters in the"&
CRLF&" question. All responses must be ended by a carriage"
&" return."&CRLF&"Novices taking pictures for printer "&
"output should,"&CRLF&" if in doubt, give the first reply "&
"indicated.|,
|are you an expert at running this program? (No or Yes)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
EXP ← ANS="Y";
LOOP: CLIPS[1,1] ← -1;
ARRBLT(CLIPS[1,2],CLIPS[1,1],11);
PICALLOC[1] ← PNTRS[1] ← 0;
ARRBLT(PICALLOC[2],PICALLOC[1],24);
ARRBLT(PNTRS[2],PNTRS[1],24);
PARTDMP ← FALSE;
QUEST (|You can enter a picture live from the TV camera "&crlf&
"or a stored picture from the disk.|,
|Tv or Disk image?|,
|(ANS←INCHWL)="D"∨ANS="T"|);
IF ANS="D" THEN
α get a picture from the disk;
BEGIN "DISKIN"
INT FILE, EXTEN, PPN, FAIL;
LABEL AGAIN;
TVREAD ← FALSE;
AGAIN: QUEST (|file names are of the form NAME.EXT[PRJ,PRG] where"
&crlf&"everything but NAME is optional.|,
|FILE NAME=|,TRUE);
FILE ← CVFIL(STR←INCHWL,EXTEN,PPN);
PICINI(1,FILE,EXTEN,PPN,FAIL,PNTRS);
IF FAIL THEN
BEGIN
OUTSTR("LOOKUP ON FILE "&STR&" FAILED");
GO TO AGAIN;
END;
OUTSTR("PICTURE FILE "&STR&" CONSISTS OF:"&CRLF);
FOR I←1 STEP 1 UNTIL 25 DO
IF PNTRS[I] THEN OUTSTR(" "&PICDES[I]&CRLF);
QUEST (| You can read in the entire picture file or "&
"select any of the parts listed.|,
|All parts or Select?|,
|(ANS←INCHWL)="A"∨ANS="S"|);
IF ANS="S" THEN OUTSTR("type 'Y' for parts wanted,"&
"anything else if not wanted"&CRLF);
FOR I←1 STEP 1 UNTIL 25 DO IF PNTRS[I] THEN
BEGIN "GETPART"
IF ANS="S" THEN OUTSTR(" "&PICDES[I]&"?");
IF ANS≠"S"∨INCHWL="Y" THEN PNTRS[I]←
BHEAD((PICALLOC[I]←GETCOR(PNTRS[I])))
ELSE PNTRS[I] ← PICALLOC[I] ← 0;
END "GETPART" ELSE PNTRS[I] ← PICALLOC[I] ← 0;
PICRD(FAIL,PNTRS);
IF FAIL THEN USERERR(0,0,"INPUT OF FILE "&STR&" FAILED");
TVLENG ← (((RSIDE-LSIDE)/9)+1)*(LLINE-FLINE+1);
TITLE ← IF PNTRS[5] THEN STRCOM(PICALLOC[5]) ELSE NULL;
DESCRIPT ← IF PNTRS[6] THEN STRCOM(PICALLOC[6]) ELSE NULL;
OUTSTR("PICTURE TITLE IS:"&(IF LENGTH(TITLE) THEN TITLE
ELSE "none")&CRLF);
IF LENGTH(DESCRIPT) THEN
BEGIN "OUTDES"
OUTSTR("picture has a description which is "&
CVS(LENGTH(DESCRIPT))&
" characters long"&CRLF);
OUTSTR("do you want to see it (Yes or No)?");
IF INCHWL="Y" THEN OUTSTR(DESCRIPT&CRLF);
END "OUTDES";
END "DISKIN" ELSE
α get a picture from the TV;
BEGIN "TVIN"
QUEST (|You can read from Cohu or Sierra cameras.|,
|Cohu or Sierra?|,
|(ANS←INCHWL)="C" ∨ ANS="S"|);
TVCAM ← IF ANS="C" THEN 1 ELSE 2;
IF TVCAM≠1 THEN OUTSTR("Do not read color pictures or"&
" ask for transform"&crlf&"The program will die"&
crlf);
QUEST (|You can now set the area of the TV image to be "&
"read in."&crlf&"The white rectangle on the "&
"TV monitor shows the area being read."&crlf&
"The four knobs on the pot box near console 21 "&
"change the rectangle."&crlf&"12 and 13 change "&
"the location of the upper left corner."&crlf&
"Knobs 14 and 15 change the length and width.|,
| |,TRUE);
α adjust size if picture, if desired;
IF TVREAD THEN
BEGIN "ADJREC"
QUEST (| |,|same area as last time? (Yes or No)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN GO TO SKIP;
END "ADJREC";
OUTSTR("Adjust the image. Type any character when you "&
"are done."&CRLF);
BEGIN INTEGER ARRAY BUF[1:10000];
TVWORD ← GIOWD(BUF);
INP;
CLRBUF;
FSAV ← FLINE;
LLSAV ← LLINE;
RSAV ← RSIDE;
LSAV ← LSIDE;
END;
DESCRIPT ← TITLE ←NULL;
α Quam sixbit or regular TV input;
SKIP: QUEST (|You can read in a normal 4 bit TV image,"&
crlf&"or an averaged 6 bit image.|,
|4 Bit or 6 bit image (4 or 6)?|,
|(BITS←CVD(INCHWL))=6∨BITS=4|);
IF (SIXBIT←BITS=6) THEN
BEGIN "QUAM"
OUTSTR("Number of images to average (4 is good) = ");
SUMS ← CVD(INCHWL);
OUTSTR("Clip level spread (2 is good) = ");
CLPINC ← CVD(INCHWL);
OUTSTR("Adjust target voltage for good image"&crlf);
OUTSTR("Pot 12 controls position of scan line"&crlf);
OUTSTR("Type Y when finished");
TCLIP ← 0;
BCLIP ← 7;
CWHEEL(3);
EYECAL(600,1,FALSE,DPYBUF);
CLRBUF;
FLINE ← FSAV;
LLINE ← LLSAV;
RSIDE ← RSAV;
LSIDE ← LSAV;
BITS ← 6;
RELPOG(1);
END "QUAM";
ADJUST;
TVLENG ← ((RSIDE-LSIDE+1)/(36 DIV BITS)+1)*(LLINE-FLINE+1);
α determine which filters he wants to use;
QUEST (| This program can read a black & white picture,"&
crlf&"a color picture (using the blue, green,"&
" and red filters)"&crlf&
"or a mixture|,
|Black & white, Color, or you Select filters?|,
|(ANS←INCHWL)="B"∨ANS="C"∨ANS="S"|);
TVREAD ← TRUE;
PICNUM ← 1;
IF ANS="B" THEN PICALLOC[CLEAR] ← TVLENG ELSE
IF ANS="C" THEN
BEGIN
PICALLOC[RED] ← TVLENG;
PICALLOC[BLUE] ← TVLENG;
PICALLOC[GREEN] ← TVLENG;
PICNUM ← 3;
END ELSE BEGIN
OUTSTR("type Y for filters desired"&CRLF);
PICNUM ← 0;
FOR I ← 1 STEP 1 UNTIL 4 DO
BEGIN
OUTSTR(FILNAM[I]&" FILTER?");
IF INCHWL="Y" THEN
BEGIN
PICALLOC[I] ← TVLENG;
PICNUM ← PICNUM+1;
END;
END;
END;
IF ¬PICNUM THEN
BEGIN
OUTSTR("You have to select at least one !!!"&CRLF);
GO TO SKIP;
END;
α set up to set sensitivity;
IF SIXBIT THEN GO TO SKIP1;
IF SENSSET THEN
BEGIN "ALLSET"
QUEST (|you can change the sensitivity again or use"
&" the"&crlf&"same settings as the last "&
"picture you read|,
|change sensitivity? (No or Yes)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="N" THEN GO TO SKIP1;
END "ALLSET" ELSE BEGIN "STEST"
SENSSET ← TRUE;
QUEST (| You can adjust the TV sensitivity to get "&
"the contrast"&CRLF&"you want. A "&
"horizontal line, whose position is "&
"controlled"&crlf&"by knob 12 of the pot "&
"box, is read in and an intensity"&crlf&
"vs. position display is shown. The clip "&
"levels can be changed by "&crlf&
"knobs 14 and 15. (0≤TCLIP≤BCLIP≤7)|,
|set clips? (Yes or No)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="N" THEN GO TO SKIP1;
END "STEST";
IF PICNUM>1 THEN
BEGIN "SETSEL"
QUEST (| You may set the sensitivity for each "&
"filter seperately,"&crlf&"or for all at "&
"once, using one of the filters you "&
"selected.|,
|set sensitivity for All or One?|,
|(ANS←INCHWL)="A"∨ANS="O"|);
IF ANS="A" THEN FOR I←1 STEP 1 UNTIL 4 DO
CLIPS[I,1]←-2 ELSE
BEGIN "WHICH" LABEL LOOP1;
LOOP1: STR ← "set sensitivity with filter:";
FOR I←1 STEP 1 UNTIL 4 DO
IF PICALLOC[I] THEN
STR ← STR&" "&FILNAM[I];
OUTSTR(STR&"?");
ANS ← INCHWL;
I←IF ANS="R" THEN 1 ELSE
IF ANS="B" THEN 2 ELSE
IF ANS="G" THEN 3 ELSE
IF ANS="C" THEN 4 ELSE 0;
IF ¬(I∧PICALLOC[I]) THEN GO TO LOOP1 ELSE
CLIPS[I,1]←-2;
END "WHICH";
END "SETSEL" ELSE
FOR I←1 STEP 1 UNTIL 4 DO CLIPS[I,1]←-2;
α set sensitivity;
OUTSTR("Type Y when satisfied"&crlf);
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I]∧CLIPS[I,1]=-2 THEN
BEGIN "SENSET"
OUTSTR(FILNAM[I]&" FILTER"&CRLF);
CWHEEL(COLNUM[I]);
EYECAL(600,1,TRUE,DPYBUF);
CLIPS[I,1] ← BCLIP;
CLIPS[I,2] ← TCLIP;
CLRBUF;
END "SENSET";
RELPOG(1);
SKIP1: FOR I←1 STEP 1 UNTIL 4 DO IF CLIPS[I,1]<0 THEN
BEGIN
CLIPS[I,1] ← BCLIP;
CLIPS[I,2] ← TCLIP;
END;
α user may want output in sections if buffers to large;
J ← 0;
FOR I ← 1 STEP 1 UNTIL 25 DO J←J+PICALLOC[I];
IF J>30000 THEN
BEGIN "PAROUT"
QUEST (|The total number of words to be read in is"&
crlf&"very large and may not be available."&
crlf&"The program can read in each image "&
"seperately and output it"&crlf&"at once to"&
"save space. Then you will have to read it"&
crlf&"in again to print or display it.|,
|Buffer size is "&cvs(j)&" Break up (Yes or No)|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN "BRKUP" LABEL LOOP3;
INTEGER FILE, PPN, EXTEN, FAIL;
PARTDMP ← TRUE;
LOOP3: OUTSTR("FILE NAME=");
FILE ← CVFIL(FILENAM←INCHWL,EXTEN,PPN);
PICWI(1,FILE,EXTEN,PPN,FAIL);
IF FAIL THEN
BEGIN
USERERR(0,0,"WRITING OF FILE "&
FILENAM&" FAILED");
GO TO LOOP3;
END;
QUEST(|You may apply a filter to the picture"&
" to enhance the edges|,
|Hipass filter (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
END "BRKUP";
END "PAROUT";
α and, finally, take the picture;
IF PARTDMP THEN TVWORD ← GETCOR(TVLENG) ELSE
FOR I←1 STEP 1 UNTIL 4 DO
IF PICALLOC[I] THEN PICALLOC[I]←GETCOR(PICALLOC[I]);
FLINE ← FSAV;
LLINE ← LLSAV;
RSIDE ← RSAV;
LSIDE ← LSAV;
OUTSTR("type a carriage return to take the picture(s)");
INCHWL;
IF SIXBIT THEN HE2Q(PIC);
FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
BEGIN "TAKE" INTEGER N, FAIL;
EXTERNAL INTEGER IND;
CWHEEL(6);
IF IND≠COLNUM[I] THEN
BEGIN
CWHEEL(COLNUM[I]);
N ← 12000;
WHILE N←N-1 DO;
END;
IF ¬PARTDMP THEN TVWORD ← PICALLOC[I];
IF SIXBIT THEN
BEGIN
TCLIP ← 0;
BCLIP ← 7;
TVSIX(PIC,SUMS,CLPINC);
END ELSE BEGIN
BCLIP ← CLIPS[I,1];
TCLIP ← CLIPS[I,2];
TVIN;
END;
IF PARTDMP THEN
BEGIN "PARTOUT"
IF ANS="Y" THEN HIPASS;
PNTRS[I]←TVWORD+1;
PICOUT(FAIL,PNTRS);
PNTRS[I]←PICALLOC[I]←0;
END "PARTOUT";
END "TAKE";
IF SIXBIT THEN Q2HE(PIC);
IF PARTDMP THEN RELCOR(TVWORD);
α and add a transform if wanted;
QUEST(|If this picture is to be used by the hand/eye system"
&crlf&"it should have a camera transform|,
|store a camera transform (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN
IF ¬CAMERR THEN CAMERR←CAMERR∨(CAM_UPDATE=10);
IF CAMERR THEN OUTSTR("CAMERA ERROR - NO TRANSFORM"
&CRLF) ELSE BEGIN
PICALLOC[7] ← GETCOR(30);
ARRTOR(BHEAD(|PICALLOC[7]|),
CAMERA_MODEL[1,1],30);
END;
END;
IF PARTDMP THEN GO TO RESTOUT;
END "TVIN";
α apply the hipass filter;
QUEST(|You may apply a filter to the picture to enhance"&
" the edges|,
|Hipass filter (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN FOR I←1 STEP 1 UNTIL 4 DO
IF PICALLOC[I] THEN
BEGIN
TVWORD ← PICALLOC[I];
HIPASS;
END;
α display the picture, if clear picture;
IF PICALLOC[1] THEN
BEGIN "DDVID"
QUEST(|you can display your picture on the data disk "&
"displays"&crlf&"if DDVID[1,PDQ] is running "&
"somewhere. The picture will be"&crlf&
"on channel 47|,
|display with DDVID (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
BEGIN
TVWORD←PICALLOC[1];
WHILE TRUE DO
BEGIN INTEGER J;
J←VIDEO(1,10,10);
IF J THEN DONE;
OUTSTR("Video failed. Try again (Y or N)?"&
CRLF);
IF INCHWL≠"Y" THEN DONE;
END;
END;
END "DDVID";
α print the picture(s) if desired;
QUEST (|Now you can output the picture(s) to the line printer, if "&
"you wish,"&crlf&"either by printing the intensity values,"&
" or simulating grey scale.|,
|print Grey scale , Intensities, "&"or Nothing?|,
|(ANS←INCHWL)="G"∨ANS="I"∨ANS="N"|);
IF ANS≠"N" THEN
BEGIN "PRINT" LABEL LOOP2;
STRING HEADR;
IF ANS="G" THEN PRTBUF←GETCOR(TVLENG);
HEADR←"TITLE: "&TITLE&CRLF&"DESCRIPTION: "&CRLF&DESCRIPT&CRLF&
"UNDER FILTERS: ";
LOOP2: FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
BEGIN STRING HEAD;
HEAD ← HEADR&" "&FILNAM[I]&CRLF;
TVWORD ← PICALLOC[I];
IF ANS="G" THEN PORTR(HEAD) ELSE PICSPL(TRUE,HEAD);
END;
OUTSTR("another copy (Yes or No)?"&CRLF);
IF INCHWL="Y" THEN GO TO LOOP2;
IF ANS="G" THEN RELCOR(PRTBUF);
END "PRINT";
α set up to output to disk if desired;
QUEST (| |,|send picture(s) to the disk (No or Yes)?|,
|(ANS←INCHWL)="Y"∨ANS="N"|);
IF ANS="Y" THEN
RESTOUT: BEGIN "DSKOUT"
INTEGER FILE, PPN, EXTEN, FAIL;
LABEL LOOP3;
IF LENGTH(TITLE) THEN
OUTSTR("title is: "&TITLE&CRLF&"would you like to "&
"change it (No or Yes)?") ELSE
OUTSTR("there is no title"&crlf&"would you like "&
"one (Yes or No)?");
IF INCHWL="Y" THEN
BEGIN
OUTSTR("type new title, ending with carriage return"
&crlf);
TITLE ← INCHWL;
END;
IF LENGTH(DESCRIPT) THEN
BEGIN
OUTSTR("would you like to see the description again"
&" (Yes or No)?");
IF INCHWL="Y" THEN OUTSTR(DESCRIPT&CRLF);
OUTSTR("would you like to change the description "&
"(No or Yes)?");
END ELSE OUTSTR("would you like to add a "&
"description (Yes of No)?");
IF INCHWL="Y" THEN
BEGIN
IF LENGTH(DESCRIPT) THEN
BEGIN
OUTSTR("Add to or Replace?");
IF INCHWL="R" THEN DESCRIPT ← NULL;
END;
OUTSTR("type new description or addition, ending "&
"with carraige return ∀ carriage return");
WHILE TRUE DO IF LENGTH(STR←INCHWL)∧STR[1 FOR 1]="∀"
THEN DONE ELSE DESCRIPT ← DESCRIPT&STR&CRLF;
END;
IF PICALLOC[5] THEN RELCOR(PICALLOC[5]);
IF PICALLOC[6] THEN RELCOR(PICALLOC[6]);
PICALLOC[5] ← IF LENGTH(TITLE) THEN ARRYCOM(TITLE) ELSE 0;
PICALLOC[6] ← IF LENGTH(DESCRIPT) THEN
ARRYCOM(DESCRIPT) ELSE 0;
FOR I←1 STEP 1 UNTIL 25 DO
PNTRS[I]←IF PICALLOC[I] THEN PICALLOC[I]+1 ELSE 0;
α and write it out;
IF PARTDMP THEN
BEGIN "OUTPART"
PICOUT(FAIL,PNTRS);
PICCLS;
RELEASE(1);
END "OUTPART" ELSE BEGIN "OUTALL"
LOOP3: OUTSTR("FILE NAME=");
FILE ← CVFIL(FILENAM←INCHWL,EXTEN,PPN);
PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
IF FAIL THEN
BEGIN
USERERR(0,0,"WRITING OF FILE "&
FILENAM&" FAILED");
GO TO LOOP3;
END;
END "OUTALL";
OUTSTR("FILE "&FILENAM&" WRITTEN OUT"&CRLF);
END "DSKOUT";
α return for next picture;
FOR I←1 STEP 1 UNTIL 25 DO
IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
OUTSTR("another picture (Yes or No)?");
IF INCHWL ="Y" THEN
BEGIN
IF ¬EXP THEN
BEGIN
OUTSTR("are you an expert yet (Yes or No)?");
EXP ← INCHWL="Y";
END;
GO TO LOOP;
END;
END;